Quick PC 61/Quick PC 61.iso/I386/WMS.CAB/wmsFileIO.inc

Text File | 2003-02-21 | 20.3 KB | 679 lines

<%
'+-------------------------------------------------------------------------
'
'  Microsoft Windows Media
'  Copyright (C) Microsoft Corporation. All rights reserved.
'
'  File:       WMSFileIO.asp
'
'  Contents:   Code for performing XML file I/O (server list file)
'
'  Dependencies:  LocStrings.asp, WMSConstants.asp
'
'--------------------------------------------------------------------------

Dim g_strErrorDescription
Dim g_strLocalHostName
Dim g_strLocalHostDNSName
Dim g_strLocalHostIP
Dim g_strDomainName
Dim g_strXMLPath
Dim g_bServerlistFileExists
Dim g_bRequireSSL
Dim g_bNeverShowSSLWarning
Dim g_FileSysObj
Dim g_bLocalHostRunningWMS
Dim g_xmlDoc
Dim g_xmlRootNode
Dim g_dwNumAvailableServers
Dim g_bWellFormedXML
Dim g_bInitialized

g_bInitialized = FALSE
on error resume next

'////////////////////////////////////////////////////////////////
Sub InitializeFileIO()

    g_bWellFormedXML = FALSE
    g_strErrorDescription = ""

    g_xmlRootNode = empty
    g_xmlDoc = empty

    if( IsEmpty( g_FileSysObj ) ) then
        Set g_FileSysObj = Server.CreateObject( "Scripting.FileSystemObject" )
    end if

    g_strXMLPath = BuildPathToXMLServerList

    Application.Lock
    g_bLocalHostRunningWMS = Application( "bLocalHostHasWMS" )
    g_strLocalHostName = Application( "strLocalHostName" )
    g_strDomainName = Application( "strDomainName" )
    g_strLocalHostDNSName = Application( "strLocalHostDNSName" )
    g_strLocalHostIP = Application( "strHostIPAddress" )
    Application.Unlock

    if( 0 = Len( g_strLocalHostName ) ) or ( 0 = Len( g_strLocalHostIP ) )then
        SyncWithApplicationState
    end if

    g_bServerlistFileExists = g_FileSysObj.FileExists( g_strXMLPath )
    g_dwNumAvailableServers = -1
    g_bRequireSSL = -1
    g_bNeverShowSSLWarning = -1

    ' init MSXML
    if( IsEmpty( g_xmlDoc ) ) then
        Set g_xmlDoc = Server.CreateObject("Microsoft.XMLDOM")
    end if
    g_xmlDoc.async = FALSE
    g_xmlDoc.validateOnParse = TRUE
    g_xmlDoc.preserveWhiteSpace = FALSE

    g_bInitialized = TRUE
End Sub


'////////////////////////////////////////////////////////////////
Function ServerListFileExists()
    if( FALSE = g_bInitialized ) then
        InitializeFileIO
    end if

    ServerListFileExists = g_bServerlistFileExists
End Function

'////////////////////////////////////////////////////////////////
'
'  Load the XML DOM, creating the XML server list if it doesn't already exist
'
Sub LoadServerList()

    if( FALSE = g_bInitialized ) then
        InitializeFileIO
    end if

    if( FALSE = g_bServerlistFileExists ) then
        if( TRUE = CreateNewServerListFile() ) then
            LoadXMLDoc
        else
            g_dwNumAvailableServers = 0
        end if
    else
        ' Load the document into the XML DOM
        LoadXMLDoc
        CompressServers
    end if
    g_dwNumAvailableServers = GetNumberOfServers()
End Sub


'////////////////////////////////////////////////////////////////
Sub LoadXMLDoc()
    on error goto 0

    if( IsEmpty( g_FileSysObj ) ) then
        Set g_FileSysObj = Server.CreateObject( "Scripting.FileSystemObject" )
    end if

    if( FALSE = g_FileSysObj.FileExists( g_strXMLPath ) ) then
        g_bServerlistFileExists = FALSE
        g_strErrorDescription = "accessDenied"
        g_bWellFormedXML = FALSE
    else
        g_bWellFormedXML = g_xmlDoc.load( g_strXMLPath )
        if( FALSE = g_bWellFormedXML ) then
            g_strErrorDescription = "badXML"
        end if
    end if

    Set g_xmlRootNode = g_xmlDoc.childNodes( 1 )
End Sub


'////////////////////////////////////////////////////////////////
Function GetNumberOfServers()
    if( FALSE = g_bWellFormedXML ) then
        GetNumberOfServers = 0
        Exit Function
    end if

    if( IsEmpty( g_xmlDoc ) or IsEmpty( g_xmlDoc.childNodes ) ) then
        GetNumberOfServers = 0
    else
        Set xmlNodeCollection = g_xmlRootNode.selectNodes( "Server" )
        GetNumberOfServers = xmlNodeCollection.length
    end if
End Function


'////////////////////////////////////////////////////////////////
Function GetServerNameByIndex( dwIndex, byRef strServerName )
    Dim xmlNodeCollection
    Dim xmlNode
    strServerName = ""

    if( FALSE = g_bWellFormedXML ) then
        GetServerNameByIndex = FALSE
        Exit Function
    end if

    GetServerNameByIndex = TRUE
    xmlNodeCollection = empty
    xmlNode = empty

    Set xmlNodeCollection = g_xmlRootNode.selectNodes( "Server" )
    if( dwIndex >= xmlNodeCollection.length ) then
        Exit Function
    end if

    Set xmlNode = xmlNodeCollection( dwIndex )
    strServerName = RemoveDangerousCharacters( Left( xmlNode.getAttribute( "Name" ), MAX_LEN_SERVERNAME ) )
    if( Null = strServerName ) then
        strServerName = "??"
    end if

    if( 0 < Len( strServerName ) ) then
        GetServerNameByIndex = FALSE
    end if
End Function


'////////////////////////////////////////////////////////////////
Function GetServerNameAndIPByIndex( dwIndex, byRef strServerName, byRef strServerIP )
    Dim xmlNodeCollection
    Dim xmlNode
    strServerName = ""
    strServerIP = ""

    '
    ' If there's an error (such as file permissions error), then we want to know about it
    '
    on error goto 0

    if( FALSE = g_bWellFormedXML ) then
        GetServerNameAndIPByIndex = FALSE
        Exit Function
    end if

    GetServerNameAndIPByIndex = TRUE
    xmlNodeCollection = empty
    xmlNode = empty

    Set xmlNodeCollection = g_xmlRootNode.selectNodes( "Server" )
    if( dwIndex >= xmlNodeCollection.length ) then
        Exit Function
    end if

    Set xmlNode = xmlNodeCollection( dwIndex )
    strServerName = xmlNode.getAttribute( "Name" )
    strServerIP = xmlNode.getAttribute( "ip" )
    if( Null = strServerName ) then
        strServerName = "??"
    else
        if( 0 < Len( strServerIP ) ) then
            on error resume next
            err.Clear
            strServerIP = s_WMSAdmin.ResolveToIP( strServerName )
            if( 0 <> err.number ) then
'                strServerName = ""
                strServerIP = ""
                GetServerNameAndIPByIndex = FALSE
                Exit Function
            end if
            xmlNode.SetAttribute "ip", strServerIP
            g_xmlDoc.save( g_strXMLPath )
            LoadXMLDoc
        end if
    end if

    if( ( 0 < Len( strServerName ) ) and ( 0 = Len( strServerIP ) ) ) then
        GetServerNameAndIPByIndex = FALSE
    end if
End Function


'////////////////////////////////////////////////////////////////
'
'  Creates an XML list file from scratch
'
Function CreateNewServerListFile()
    CreateNewServerListFile = FALSE
    on error resume next
    Set pi = g_xmlDoc.createProcessingInstruction("xml", " version=""1.0"" encoding=""utf-16"" standalone=""yes""")

    Set g_xmlRootNode = g_xmlDoc.CreateNode( "element", "WMSAdmin", "" )
    Set g_xmlDoc.documentElement = g_xmlRootNode

    g_xmlDoc.insertBefore pi, g_xmlDoc.childNodes.item(0)

    if( g_bLocalHostRunningWMS ) then
        g_xmlDoc.save( g_strXMLPath )
        g_bWellFormedXML = TRUE

        if( IsEmpty( g_FileSysObj ) ) then
            Set g_FileSysObj = Server.CreateObject( "Scripting.FileSystemObject" )
        end if

        g_bServerlistFileExists = g_FileSysObj.FileExists( g_strXMLPath )

'        AddServerToXMLDOM g_strLocalHostName, g_strLocalHostIP, strErr
        AddServerToXMLDOM "localhost", "127.0.0.1", strErr
        g_dwNumAvailableServers = 1
'        PutNamedPreference "RequireSSL", "1"
    else
        g_xmlDoc.save( g_strXMLPath )
    end if

    g_strErrorDescription = ""
    g_bServerlistFileExists = TRUE
    CreateNewServerListFile = TRUE
End Function


'////////////////////////////////////////////////////////////////
Function IsServerNameInXMLDOM( strName )
on error goto 0
    IsServerNameInXMLDOM = TRUE

    if( FALSE = g_bWellFormedXML ) then
        IsServerNameInXMLDOM = FALSE
        Exit Function
    end if

    strQueryString = "Server[@Name='" & strName & "']"
    Set xmlMatchingNodes = g_xmlRootNode.selectNodes( strQueryString )
    if( 0 = xmlMatchingNodes.length ) then
        IsServerNameInXMLDOM = FALSE
    end if
End Function


'////////////////////////////////////////////////////////////////
Function IsServerIPInXMLDOM( strIPAddress )
    Dim MatchingXMLNodes
    IsServerIPInXMLDOM = FindServersByIP( MatchingXMLNodes, strIPAddress )
End Function


'////////////////////////////////////////////////////////////////
Function FindServersByIP( byRef xmlMatchingServers, strIP )
    FindServersByIP = Null

    if( FALSE = g_bWellFormedXML ) then
        Exit Function
    end if

    if( 0 >= Len( strIP ) ) then
        Exit Function
    end if

    strQueryString = "Server[@ip='" & strIP & "']"
    Set xmlMatchingServers = g_xmlRootNode.selectNodes( strQueryString )
    FindServersByIP = xmlMatchingServers.length
End Function


'////////////////////////////////////////////////////////////////
Function AddServerToXMLDOM( strName, strIPAddress, byRef strErrString )
on error goto 0
    Dim bNameExists
    bNameExists = FALSE
    AddServerToXMLDOM = FALSE
    strErrString = L_NOXMLADD_TEXT

    if( FALSE = g_bWellFormedXML ) then
        strErrString = "badXML"
        Exit Function
    end if

    if( 0 >= Len( strName ) ) then
        strErrString = "invalidarg"
        Exit Function
    end if

    if( 0 = strcomp( g_strLocalHostName, strName, vbStringCompare ) ) or ( strIPAddress = g_strLocalHostIP ) then
        bNameExists = IsServerNameInXMLDOM( strName )
        if( FALSE = bNameExists ) then
            bNameExists = IsServerIPInXMLDOM( strIPAddress )
        end if
        if( bNameExists ) then
            strErrString = "duplicate"
            Exit Function
        else
            strName = "localhost"
            strIPAddress = "127.0.0.1"
        end if
    end if

    if( ( FALSE = IsServerNameInXMLDOM( strName ) ) and _
        ( FALSE = IsServerIPInXMLDOM( strIPAddress ) ) ) then
        Set xmlServerNode = g_xmlDoc.CreateNode( "element", "Server", "" )

        xmlServerNode.setAttribute "Name", strName
        xmlServerNode.setAttribute "ip", strIPAddress
        g_xmlRootNode.appendChild( xmlServerNode )

        g_xmlDoc.save( g_strXMLPath )
        AddServerToXMLDOM = TRUE
        strErrString = ""
    else
        strErrString = "duplicate"
    end if
End Function


'////////////////////////////////////////////////////////////////
Function GetServerNodeByName( strName )
    GetServerNodeByName = Null

    if( FALSE = g_bWellFormedXML ) then
        Exit Function
    end if

    if( 0 >= Len( strName ) ) then
        STOP
        Exit Function
    end if

    Dim xmlServerNode
    Dim xmlServerNodeAttributes
    Dim xmlServerName

    Set xmlServerNode = g_xmlRootNode.firstChild
    if( Null <> xmlServerNode ) then

        Do
            Set xmlServerNodeAttributes = xmlServerNode.attributes
            if( 0 = StrComp( strName, xmlServerNodeAttributes.Name, vbTextCompare ) ) then
                GetServerNodeByName = xmlServerNode
                Exit Function
            end if
            xmlServerNode = xmlServerNode.nextSibling
        Loop until( Null <> xmlServerNode )

    end if
End Function


'////////////////////////////////////////////////////////////////
Function GetServerNodeByIP( strIP )
    GetServerNodeByIP = Null

    if( FALSE = g_bWellFormedXML ) then
        Exit Function
    end if

    if( 0 >= Len( strIP ) ) then
        STOP
        Exit Function
    end if

    Dim xmlServerNode
    Dim xmlServerNodeAttributes
    Dim xmlServerName

    Set xmlServerNode = g_xmlRootNode.firstChild
    If( Null <> xmlServerNode ) then

        Do
            Set xmlServerNodeAttributes = xmlServerNode.attributes
            If( 0 = StrComp( strIP, xmlServerNodeAttributes.ip, vbTextCompare ) ) then
                GetServerNodeByIP = xmlServerNode
                Exit Function
            End If
            xmlServerNode = xmlServerNode.nextSibling
        Loop until( Null <> xmlServerNode )

    End If
End Function


'////////////////////////////////////////////////////////////////
Sub RemoveServerByIndex( dwIndex )
    Dim xmlServerNodeToRemove

    if( FALSE = g_bWellFormedXML ) then
        Exit Sub
    end if

    Set xmlServerNodeList = g_xmlRootNode.selectNodes( "Server" )
    Set xmlServerNodeToRemove = xmlServerNodeList( dwIndex )
    g_xmlRootNode.removeChild( xmlServerNodeToRemove )

    g_xmlDoc.save( g_strXMLPath )
    LoadXMLDoc
End Sub



'////////////////////////////////////////////////////////////////
Sub CompressServers()
    Dim xmlEachNode
    Dim xmlMatchingNodes
    Dim xmlServerNodeList
    Dim xmlDuplicateNode
    Dim xmlServerName
    Dim bDuplicatesFound
    Dim i

    if( FALSE = g_bWellFormedXML ) then
        exit sub
    end if

    bDuplicatesFound = FALSE

'    Set xmlServerNodeList = g_xmlDoc.selectNodes( "//WMSAdmin[Server/@Name != '']" )
    strTmp = "Server"
    Set xmlServerNodeList = g_xmlRootNode.selectNodes( strTmp )

    if( 0 < xmlServerNodeList.length ) then
        i = 0
        Do
            Set xmlEachNode = xmlServerNodeList( i )
            strIP = xmlEachNode.getAttribute( "ip" )

            dwNumMatches = FindServersByIP( xmlMatchingNodes, strIP )

            if( 1 < dwNumMatches ) then
                bDuplicatesFound = TRUE
                for dwIndex = 1 to ( xmlMatchingNodes.length - 1 )
                    Set xmlDuplicateNode = xmlMatchingNodes( dwIndex )
                    g_xmlRootNode.removeChild( xmlDuplicateNode )
                next

                if( bDuplicatesFound ) then
                    g_xmlDoc.save( g_strXMLPath )
                    LoadXMLDoc
                    bDuplicatesFound = FALSE
                end if
            end if

            i = i + 1
        Loop until xmlServerNodeList.length = i
    end if
End Sub

' ///////////////////////////////////////////////////////
'
'  Misc utils
'
' ///////////////////////////////////////////////////////

'////////////////////////////////////////////////////////////////
Function BuildPathToXMLServerList()
    Dim strPathToThisFile
    Dim strPathToParentDir
    Dim strUserPrefix

    on error resume next

    strPathToThisFile = server.MapPath( Request.ServerVariables( "PATH_INFO" ) )
    dwOffsetToLastSlash = InStrRev( strPathToThisFile, "\", -1, vbTextCompare )
    strPathToParentDir = Left( strPathToThisFile, dwOffsetToLastSlash )
    dwOffsetToLastSlash = InStrRev( strPathToParentDir, "\", -1, vbTextCompare )
    strUserPrefix = Server.CreateObject( "WScript.Network" ).UserName
    if( 0 = Len( strUserPrefix ) ) then
        strUserPrefix = Request.ServerVariables( "REMOTE_USER" )
        if( 0 < Len( strUserPrefix ) ) then
            dwOffsetToLastSlash = InStrRev( strUserPrefix, "\", -1, vbTextCompare )
            if( 0 < dwOffsetToLastSlash ) then
                strUserPrefix = Right( strUserPrefix, Len( strUserPrefix ) - dwOffsetToLastSlash )
            end if
        end if
    end if

    if( FALSE = g_FileSysObj.FileExists( strPathToParentDir & "Users" ) ) then
        g_FileSysObj.CreateFolder( strPathToParentDir & "Users" )
    end if

    BuildPathToXMLServerList = strPathToParentDir & "Users\" & strUserPrefix & "_" & SERVERLISTFILENAME
'   BuildPathToXMLServerList = Left( strPathToThisFile, dwOffsetToLastSlash ) & SERVERLISTFILENAME
End Function



'////////////////////////////////////////////////////////////////
'
' Support for creating and managing user preferences
'
'////////////////////////////////////////////////////////////////


'////////////////////////////////////////////////////////////////
Function GetNamedPreference( strPrefAttrName )
    Dim xmlNodeCollection
    Dim xmlNode
    Dim xmlPropsNode

    if( FALSE = g_bInitialized ) then
        LoadServerList
    end if

    if( 0 = strcomp( strPrefAttrName, "RequireSSL", vbStringCompare ) ) then
        if( -1 <> g_bRequireSSL ) then
            GetNamedPreference = g_bRequireSSL
            Exit Function
        end if
    else
        if( -1 <> g_bNeverShowSSLWarning ) then
            GetNamedPreference = g_bNeverShowSSLWarning
            Exit Function
        end if
    end if

    GetNamedPreference = FALSE

    if( FALSE = g_bWellFormedXML ) then
        Exit Function
    end if

    xmlNodeCollection = empty
    xmlNode = empty
    xmlPropsNode = empty

    Set xmlNodeCollection = g_xmlRootNode.selectNodes( "Preferences" )
    if( 0 = xmlNodeCollection.length ) then
        if( 0 = strcomp( strPrefAttrName, "RequireSSL", vbStringCompare ) ) then
            PutNamedPreference strPrefAttrName, g_bRequireSSL
            GetNamedPreference = g_bRequireSSL
        else
            PutNamedPreference strPrefAttrName, g_bNeverShowSSLWarning
            GetNamedPreference = g_bNeverShowSSLWarning
        end if
        Exit Function
    end if

    Set xmlPrefsNode = xmlNodeCollection( 0 )
    if( IsEmpty( xmlPrefsNode ) ) then
        if( 0 = strcomp( strPrefAttrName, "RequireSSL", vbStringCompare ) ) then
            g_bRequireSSL = TRUE
            PutNamedPreference strPrefAttrName, g_bRequireSSL
            GetNamedPreference = g_bRequireSSL
        else
            g_bNeverShowSSLWarning = TRUE
            PutNamedPreference strPrefAttrName, g_bNeverShowSSLWarning
            GetNamedPreference = g_bNeverShowSSLWarning
        end if
        Exit Function
    end if

    g_bRequireSSL = ( 0 = strcomp( "1", xmlPrefsNode.getAttribute( strPrefAttrName ), vbTextCompare ) )
    GetNamedPreference = g_bRequireSSL

End Function


'////////////////////////////////////////////////////////////////
Function PutNamedPreference( strPrefAttrName, strAttrValue )
    Dim xmlNodeCollection
    Dim xmlNode
    Dim xmlPropsNode

    if( FALSE = g_bInitialized ) then
        LoadServerList
    end if

    if( 0 = strcomp( strPrefAttrName, "RequireSSL", vbStringCompare ) ) then
        g_bRequireSSL = ( 0 = strcomp( "1", strAttrValue, vbTextCompare ) )
    else
        g_bNeverShowSSLWarning = ( 0 = strcomp( "1", strAttrValue, vbTextCompare ) )
    end if

    PutNamedPreference = TRUE

    if( FALSE = g_bWellFormedXML ) then
        Exit Function
    end if

    xmlNodeCollection = empty
    xmlNode = empty
    xmlPropsNode = empty

    Set xmlNodeCollection = g_xmlRootNode.selectNodes( "Preferences" )
    if( 0 = xmlNodeCollection.length ) then
        Set xmlPrefsNode = g_xmlDoc.CreateNode( "element", "Preferences", "" )
        xmlPrefsNode.setAttribute "RequireSSL", strAttrValue
        g_xmlRootNode.appendChild( xmlPrefsNode )
        g_xmlDoc.save( g_strXMLPath )
        PutNamedPreference = TRUE
    else
        Set xmlPrefsNode = xmlNodeCollection( 0 )
        if( IsEmpty( xmlPrefsNode ) ) then
            Set xmlPrefsNode = g_xmlDoc.CreateNode( "element", "Preferences", "" )
            g_xmlRootNode.appendChild( xmlPrefsNode )
        end if

        xmlPrefsNode.setAttribute strPrefAttrName, strAttrValue

        g_xmlDoc.save( g_strXMLPath )
        PutNamedPreference = TRUE
    end if
End Function

'////////////////////////////////////////////////////////////////
'
' Free the various globals we created by server-side-including this file
'
Sub WMSFileIOASPCleanup
    g_strErrorDescription = nothing
    g_strLocalHostName = nothing
    g_strLocalHostDNSName = nothing
    g_strLocalHostIP = nothing
    g_strDomainName = nothing
    g_strXMLPath = nothing
    g_bServerlistFileExists = nothing
    g_bRequireSSL = nothing
    g_bNeverShowSSLWarning = nothing
    g_FileSysObj = nothing
    g_bLocalHostRunningWMS = nothing
    g_xmlDoc = nothing
    g_xmlRootNode = nothing
    g_dwNumAvailableServers = nothing
    g_bWellFormedXML = nothing
    g_bInitialized = nothing
End Sub

%>